home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
ADA Programming Guide
/
ADA Programming Guide.iso
/
adatutor
/
csparts
/
clibody.src
< prev
next >
Wrap
Text File
|
1996-01-30
|
43KB
|
1,197 lines
--::::::::::
--clibody.inc
--::::::::::
-- This include file
clibody.inc
-- Select one of these package
-- bodies, depending on your compiler
-- CLIALUNX - Alsys Ada for UNIX
-- CLIALDOS - Alsys Ada for DOS
-- CLICAIS - CAIS
-- CLIINTGR - Integr/Ada
-- CLIMERDN - Meridian Ada
-- CLIVERDX - Verdix Ada
-- CLIVMS - DEC Ada
-- CLIGENRL - Any other compiler
clialunx.ada
clialdos.ada
clicais.ada
cligenrl.ada
cliintgr.ada
climerdn.ada
cliverdx.ada
clivms.ada
--::::::::::
--clialunx.ada
--::::::::::
-- This implementation of Package Body CLI is Alsys-specific (SUN).
-- It requires the Alsys package SYSTEM_ENVIRONMENT.
-- Alsys Ada, Version 3.2
with TEXT_IO;
with SYSTEM_ENVIRONMENT;
package body CLI is
LOCAL_ARGC : NATURAL := SYSTEM_ENVIRONMENT.ARG_COUNT;
-- Value of ARGC as stored internally
procedure INITIALIZE (PROGRAM_NAME : in STRING;
COMMAND_LINE_PROMPT : in STRING) is
--========================= PDL ===========================
--|ABSTRACT:
--| INITIALIZE performs necessary initializations.
--|DESIGN DESCRIPTION:
--| No initialization needed
--=========================================================
begin
null;
end INITIALIZE;
function ARGC return NATURAL is
--========================= PDL ===========================
--|ABSTRACT:
--| ARGC returns the argument count.
--|DESIGN DESCRIPTION:
--| Return LOCAL_ARGC
--=========================================================
begin
return LOCAL_ARGC;
end ARGC;
function ARGV (INDEX : in NATURAL) return STRING is
--========================= PDL ===========================
--|ABSTRACT:
--| ARGV returns the indicated argument string.
--|DESIGN DESCRIPTION:
--| If INDEX is out of range, raise INVALID_INDEX
--| Return GET_FROM_LIST(INDEX)
--=========================================================
begin
if INDEX >= LOCAL_ARGC then
raise INVALID_INDEX;
end if;
return SYSTEM_ENVIRONMENT.ARG_VALUE (INDEX);
exception
when INVALID_INDEX =>
raise ;
when others =>
raise UNEXPECTED_ERROR;
end ARGV;
end CLI;
--::::::::::
--clialdos.ada
--::::::::::
--::::::::::
--clialsys.ada
--::::::::::
-- This implementation of Package Body CLI is Alsys-specific (SUN).
-- It requires the Alsys package DOS.
-- Alsys Ada, Version 5
with DOS;
package body CLI is
LOCAL_ARGC : NATURAL;
type TOKEN_SCAN_STATE is (OUTSIDE_OF_TOKEN, INSIDE_OF_TOKEN);
function ARGC_VALUE (TOKENS : in STRING) return NATURAL is
COUNTER : NATURAL := 0;
CURRENT_STATE : TOKEN_SCAN_STATE := OUTSIDE_OF_TOKEN;
begin
for I in TOKENS'FIRST .. TOKENS'LAST loop
case CURRENT_STATE is
when OUTSIDE_OF_TOKEN =>
if TOKENS(I) > ' ' then
COUNTER := COUNTER + 1;
CURRENT_STATE := INSIDE_OF_TOKEN;
end if;
when INSIDE_OF_TOKEN =>
if TOKENS(I) <= ' ' then
CURRENT_STATE := OUTSIDE_OF_TOKEN;
end if;
end case;
end loop;
return COUNTER;
end ARGC_VALUE;
procedure INITIALIZE (PROGRAM_NAME : in STRING;
COMMAND_LINE_PROMPT : in STRING) is
--========================= PDL ===========================
--|ABSTRACT:
--| INITIALIZE performs necessary initializations.
--|DESIGN DESCRIPTION:
--| Set the value of LOCAL_ARGC by parsing tokens.
--=========================================================
begin
LOCAL_ARGC := ARGC_VALUE (DOS.GET_PARMS) + 1;
end INITIALIZE;
function ARGC return NATURAL is
--========================= PDL ===========================
--|ABSTRACT:
--| ARGC returns the argument count.
--|DESIGN DESCRIPTION:
--| Return LOCAL_ARGC.
--=========================================================
begin
return LOCAL_ARGC;
end ARGC;
function ARG_VALUE (TOKENS : in STRING; INDEX : in NATURAL)
return STRING is
FIRST, LAST, COUNTER : NATURAL;
CURRENT_STATE : TOKEN_SCAN_STATE := OUTSIDE_OF_TOKEN;
begin
FIRST := TOKENS'FIRST;
LAST := TOKENS'FIRST-1;
COUNTER := 0;
if INDEX = 0 then
return DOS.GET_PROGRAM_NAME;
else
for I in TOKENS'FIRST .. TOKENS'LAST loop
case CURRENT_STATE is
when OUTSIDE_OF_TOKEN =>
if TOKENS(I) > ' ' then
COUNTER := COUNTER + 1;
CURRENT_STATE := INSIDE_OF_TOKEN;
if COUNTER = INDEX then
FIRST := I;
LAST := TOKENS'LAST;
end if;
end if;
when INSIDE_OF_TOKEN =>
if TOKENS(I) <= ' ' then
CURRENT_STATE := OUTSIDE_OF_TOKEN;
if COUNTER = INDEX then
LAST := I - 1;
end if;
end if;
end case;
end loop;
if LAST < FIRST then
return "";
else
return TOKENS(FIRST .. LAST);
end if;
end if;
end ARG_VALUE;
function ARGV (INDEX : in NATURAL) return STRING is
--========================= PDL ===========================
--|ABSTRACT:
--| ARGV returns the indicated argument string.
--|DESIGN DESCRIPTION:
--| If INDEX is out of range, raise INVALID_INDEX
--| Run parse and return desired token.
--=========================================================
begin
if INDEX >= LOCAL_ARGC then
raise INVALID_INDEX;
end if;
return ARG_VALUE (DOS.GET_PARMS, INDEX);
exception
when INVALID_INDEX =>
raise ;
when others =>
raise UNEXPECTED_ERROR;
end ARGV;
begin -- Initialization section
INITIALIZE("", "");
end CLI;
--::::::::::
--clicais.ada
--::::::::::
-- This implementation of Package Body CLI interfaces thru a CAIS
-- (CAIS = Common APSE Interface Set, where APSE = Ada Programming
-- Support Environment).
-- The definition of CAIS used was DoD-STD-1838, dated 9 October 1986.
-- Note: THIS IS UNTESTED BUT BELIEVED TO BE CORRECT (no working CAIS
-- implementation was available to test this against).
with CAIS_PROCESS_DEFINITIONS;
with CAIS_PROCESS_MANAGEMENT;
with CAIS_LIST_MANAGEMENT;
package body CLI is
LOCAL_ARGC : NATURAL := 1;
-- Local ARGC value used internally
package STRING_LIST is
NUMBER_OF_STRINGS : NATURAL := 0;
procedure ADD_TO_LIST (ITEM : in STRING);
function GET_FROM_LIST (ITEM : in NATURAL) return STRING;
end STRING_LIST;
package body STRING_LIST is
type DYNAMIC_STRING_OBJECT (LENGTH : NATURAL);
type DYNAMIC_STRING is access DYNAMIC_STRING_OBJECT;
type DYNAMIC_STRING_OBJECT (LENGTH : NATURAL) is
record
DS : STRING (1 .. LENGTH);
NEXT : DYNAMIC_STRING;
end record;
FIRST : DYNAMIC_STRING := null;
LAST : DYNAMIC_STRING := null;
procedure ADD_TO_LIST (ITEM : in STRING) is
--========================= PDL ===========================
--|ABSTRACT:
--| ADD_TO_LIST adds the ITEM string to the linked list
--| of dynamic strings implemented by this package.
--|DESIGN DESCRIPTION:
--| Create new DYNAMIC_STRING_OBJECT of the proper length
--| Set DS field of new object to the ITEM string
--| Set the NEXT field of the new object to NULL
--| If FIRST pointer is null
--| Set FIRST and LAST to point to the new object
--| Else
--| Set LAST.NEXT to point to the new object
--| Set LAST to point to the new object
--| End if
--| Increment NUMBER_OF_STRINGS
--=========================================================
TEMP : DYNAMIC_STRING;
begin
TEMP := new DYNAMIC_STRING_OBJECT (ITEM'LENGTH);
TEMP.DS (1 .. ITEM'LENGTH) := ITEM;
TEMP.NEXT := null;
if FIRST = null then
FIRST := TEMP;
LAST := TEMP;
else
LAST.NEXT := TEMP;
LAST := TEMP;
end if;
NUMBER_OF_STRINGS := NUMBER_OF_STRINGS + 1;
end ADD_TO_LIST;
function GET_FROM_LIST (ITEM : in NATURAL) return STRING is
--========================= PDL ===========================
--|ABSTRACT:
--| GET_FROM_LIST returns the ITEM string from the linked list
--| of dynamic strings implemented by this package.
--|DESIGN DESCRIPTION:
--| If ITEM > 0
--| Advance to desired item
--| End If
--| Return the DS field of the desired item
--=========================================================
ROVER : DYNAMIC_STRING := FIRST;
begin
if ITEM > 0 then
for I in 1 .. ITEM loop
ROVER := ROVER.NEXT;
end loop;
end if;
return ROVER.DS;
end GET_FROM_LIST;
end STRING_LIST;
procedure INITIALIZE (PROGRAM_NAME : in STRING;
COMMAND_LINE_PROMPT : in STRING) is
--========================= PDL ===========================
--|ABSTRACT:
--| INITIALIZE prompts the user for the command line
--| arguments and loads the linked list with them.
--|DESIGN DESCRIPTION:
--| Set the first list object to PROGRAM_NAME
--| Get the list of parameters for the process
--| For each parameter, loop
--| Extract the next parameter (item)
--| Convert the parameter (item) to text
--| Add text to the list
--| End Loop
--| Set LOCAL_ARGC to NUMBER_OF_STRINGS
--=========================================================
PARAMETERS : CAIS_PROCESS_DEFINITIONS.PARAMETER_LIST;
CURRENT_PARAMETER : CAIS_PROCESS_DEFINITIONS.PARAMETER_LIST;
NUMBER_OF_PARAMETERS : CAIS_LIST_MANAGEMENT.LIST_SIZE;
begin
STRING_LIST.ADD_TO_LIST(PROGRAM_NAME);
CAIS_PROCESS_MANAGEMENT.GET_PARAMETERS (PARAMETERS);
NUMBER_OF_PARAMETERS := CAIS_LIST_MANAGEMENT.NUMBER_OF_ITEMS
(PARAMETERS);
for I in 1 .. NUMBER_OF_PARAMETERS loop
CAIS_LIST_MANAGEMENT.CAIS_LIST_ITEM.EXTRACT_VALUE
(FROM_LIST => PARAMETERS,
ITEM_POSITION => I,
VALUE => CURRENT_PARAMETER);
STRING_LIST.ADD_TO_LIST
(CAIS_LIST_MANAGEMENT.TEXT_FORM(CURRENT_PARAMETER));
end loop;
LOCAL_ARGC := STRING_LIST.NUMBER_OF_STRINGS;
end INITIALIZE;
function ARGC return NATURAL is
--========================= PDL ===========================
--|ABSTRACT:
--| ARGC returns the argument count.
--|DESIGN DESCRIPTION:
--| Return LOCAL_ARGC
--=========================================================
begin
return LOCAL_ARGC;
end ARGC;
function ARGV (INDEX : in NATURAL) return STRING is
--========================= PDL ===========================
--|ABSTRACT:
--| ARGV returns the indicated argument string.
--|DESIGN DESCRIPTION:
--| If INDEX is out of range, raise INVALID_INDEX
--| Return GET_FROM_LIST(INDEX)
--=========================================================
begin
if INDEX >= ARGC then
raise INVALID_INDEX;
end if;
return STRING_LIST.GET_FROM_LIST (INDEX);
exception
when INVALID_INDEX =>
raise ;
when others =>
raise UNEXPECTED_ERROR;
end ARGV;
end CLI;
--::::::::::
--cligenrl.ada
--::::::::::
-- This implementation of Package Body CLI is general-purpose.
-- Using TEXT_IO, it prompts the user for input arguments and
-- accepts these arguments via a GET_LINE call.
with TEXT_IO;
package body CLI is
LOCAL_ARGC : NATURAL := 0;
package STRING_LIST is
NUMBER_OF_STRINGS : NATURAL := 0;
procedure ADD_TO_LIST (ITEM : in STRING);
function GET_FROM_LIST (ITEM : in NATURAL) return STRING;
end STRING_LIST;
package body STRING_LIST is
type DYNAMIC_STRING_OBJECT (LENGTH : NATURAL);
type DYNAMIC_STRING is access DYNAMIC_STRING_OBJECT;
type DYNAMIC_STRING_OBJECT (LENGTH : NATURAL) is
record
DS : STRING (1 .. LENGTH);
NEXT : DYNAMIC_STRING;
end record;
FIRST : DYNAMIC_STRING := null;
LAST : DYNAMIC_STRING := null;
procedure ADD_TO_LIST (ITEM : in STRING) is
--========================= PDL ===========================
--|ABSTRACT:
--| ADD_TO_LIST adds the ITEM string to the linked list
--| of dynamic strings implemented by this package.
--|DESIGN DESCRIPTION:
--| Create new DYNAMIC_STRING_OBJECT of the proper length
--| Set DS field of new object to the ITEM string
--| Set the NEXT field of the new object to NULL
--| If FIRST pointer is null
--| Set FIRST and LAST to point to the new object
--| Else
--| Set LAST.NEXT to point to the new object
--| Set LAST to point to the new object
--| End if
--| Increment NUMBER_OF_STRINGS
--=========================================================
TEMP : DYNAMIC_STRING;
begin
TEMP := new DYNAMIC_STRING_OBJECT (ITEM'LENGTH);
TEMP.DS (1 .. ITEM'LENGTH) := ITEM;
TEMP.NEXT := null;
if FIRST = null then
FIRST := TEMP;
LAST := TEMP;
else
LAST.NEXT := TEMP;
LAST := TEMP;
end if;
NUMBER_OF_STRINGS := NUMBER_OF_STRINGS + 1;
end ADD_TO_LIST;
function GET_FROM_LIST (ITEM : in NATURAL) return STRING is
--========================= PDL ===========================
--|ABSTRACT:
--| GET_FROM_LIST returns the ITEM string from the linked list
--| of dynamic strings implemented by this package.
--|DESIGN DESCRIPTION:
--| If ITEM > 0
--| Advance to desired item
--| End If
--| Return the DS field of the desired item
--=========================================================
ROVER : DYNAMIC_STRING := FIRST;
begin
if ITEM > 0 then
for I in 1 .. ITEM loop
ROVER := ROVER.NEXT;
end loop;
end if;
return ROVER.DS;
end GET_FROM_LIST;
end STRING_LIST;
procedure INITIALIZE (PROGRAM_NAME : in STRING;
COMMAND_LINE_PROMPT : in STRING) is
--========================= PDL ===========================
--|ABSTRACT:
--| INITIALIZE prompts the user for the command line
--| arguments and loads the linked list with them.
--|DESIGN DESCRIPTION:
--| Set CURRENT_STATE to LOOKING_FOR_TOKEN
--| Set the first list object to PROGRAM_NAME
--| Prompt the user with COMMAND_LINE_PROMPT and
--| get his response
--| Over number of characters in line, loop
--| Case CURRENT_STATE
--| When LOOKING_FOR_TOKEN
--| If character is not white-space
--| Set CURRENT_STATE to IN_TOKEN
--| If character is quote (")
--| Set QUOTED to TRUE
--| Set START to the character's index + 1
--| Else
--| Set QUOTED to FALSE
--| Set START to the character's index
--| End IF
--| End If
--| When IN_TOKEN
--| If QUOTED
--| If character is quote (")
--| Set STOP to the previous character's index
--| Add slice from START to STOP to list
--| Set CURRENT_STATE to LOOKING_FOR_TOKEN
--| End If
--| ElsIF character is white-space
--| Set STOP to the previous character's index
--| Add slice from START to STOP to list
--| Set CURRENT_STATE to LOOKING_FOR_TOKEN
--| End If
--| End Case
--| End Loop
--| If CURRENT_STATE is IN_TOKEN
--| Set STOP to the previous character's index
--| Add slice from START to STOP to list
--| End if
--| Set LOCAL_ARGC to NUMBER_OF_STRINGS
--| Output NEW_LINE (to reset column count in TEXT_IO)
--=========================================================
ARGCOUNT : NATURAL := 1;
INLINE : STRING (1 .. 400);
LAST : NATURAL;
START : NATURAL;
STOP : NATURAL;
QUOTED : BOOLEAN;
type STATE is (LOOKING_FOR_TOKEN, IN_TOKEN);
CURRENT_STATE : STATE := LOOKING_FOR_TOKEN;
begin
STRING_LIST.ADD_TO_LIST (PROGRAM_NAME);
TEXT_IO.PUT (COMMAND_LINE_PROMPT);
TEXT_IO.GET_LINE (INLINE, LAST);
for I in 1 .. LAST loop
case CURRENT_STATE is
when LOOKING_FOR_TOKEN =>
if INLINE (I) > ' ' then
CURRENT_STATE := IN_TOKEN;
if INLINE (I) = '"' then
QUOTED := TRUE;
START := I;
else
QUOTED := FALSE;
START := I;
end if;
end if;
when IN_TOKEN =>
if QUOTED then
if INLINE (I) = '"' then
STOP := I;
STRING_LIST.ADD_TO_LIST (INLINE (START .. STOP));
CURRENT_STATE := LOOKING_FOR_TOKEN;
end if;
elsif INLINE (I) <= ' ' then
STOP := I - 1;
STRING_LIST.ADD_TO_LIST (INLINE (START .. STOP));
CURRENT_STATE := LOOKING_FOR_TOKEN;
end if;
end case;
end loop;
if CURRENT_STATE = IN_TOKEN then
STOP := LAST;
STRING_LIST.ADD_TO_LIST (INLINE (START .. STOP));
end if;
LOCAL_ARGC := STRING_LIST.NUMBER_OF_STRINGS;
TEXT_IO.NEW_LINE;
end INITIALIZE;
function ARGC return NATURAL is
--========================= PDL ===========================
--|ABSTRACT:
--| ARGC returns the argument count.
--|DESIGN DESCRIPTION:
--| Return LOCAL_ARGC
--=========================================================
begin
return LOCAL_ARGC;
end ARGC;
function ARGV (INDEX : in NATURAL) return STRING is
--========================= PDL ===========================
--|ABSTRACT:
--| ARGV returns the indicated argument string.
--|DESIGN DESCRIPTION:
--| If INDEX is out of range, raise INVALID_INDEX
--| Return GET_FROM_LIST(INDEX)
--=========================================================
begin
if INDEX >= LOCAL_ARGC then
raise INVALID_INDEX;
end if;
return STRING_LIST.GET_FROM_LIST (INDEX);
exception
when INVALID_INDEX =>
raise ;
when others =>
raise UNEXPECTED_ERROR;
end ARGV;
end CLI;
--::::::::::
--cliintgr.ada
--::::::::::
-- This implementation of Package Body CLI is for IntegrAda.
-- It has been tested under IntegrAda 4.0.1 using MSDOS 3.3.
with UTIL;
package body CLI is
LOCAL_ARGC : NATURAL := 1;
-- Local ARGC value stored internally
package STRING_LIST is
NUMBER_OF_STRINGS : NATURAL := 0;
procedure ADD_TO_LIST (ITEM : in STRING);
function GET_FROM_LIST (ITEM : in NATURAL) return STRING;
end STRING_LIST;
package body STRING_LIST is
type DYNAMIC_STRING_OBJECT (LENGTH : NATURAL);
type DYNAMIC_STRING is access DYNAMIC_STRING_OBJECT;
type DYNAMIC_STRING_OBJECT (LENGTH : NATURAL) is
record
DS : STRING (1 .. LENGTH);
NEXT : DYNAMIC_STRING;
end record;
FIRST : DYNAMIC_STRING := null;
LAST : DYNAMIC_STRING := null;
procedure ADD_TO_LIST (ITEM : in STRING) is
--========================= PDL ===========================
--|ABSTRACT:
--| ADD_TO_LIST adds the ITEM string to the linked list
--| of dynamic strings implemented by this package.
--|DESIGN DESCRIPTION:
--| Create new DYNAMIC_STRING_OBJECT of the proper length
--| Set DS field of new object to the ITEM string
--| Set the NEXT field of the new object to NULL
--| If FIRST pointer is null
--| Set FIRST and LAST to point to the new object
--| Else
--| Set LAST.NEXT to point to the new object
--| Set LAST to point to the new object
--| End if
--| Increment NUMBER_OF_STRINGS
--=========================================================
TEMP : DYNAMIC_STRING;
begin
TEMP := new DYNAMIC_STRING_OBJECT (ITEM'LENGTH);
TEMP.DS (1 .. ITEM'LENGTH) := ITEM;
TEMP.NEXT := null;
if FIRST = null then
FIRST := TEMP;
LAST := TEMP;
else
LAST.NEXT := TEMP;
LAST := TEMP;
end if;
NUMBER_OF_STRINGS := NUMBER_OF_STRINGS + 1;
end ADD_TO_LIST;
function GET_FROM_LIST (ITEM : in NATURAL) return STRING is
--========================= PDL ===========================
--|ABSTRACT:
--| GET_FROM_LIST returns the ITEM string from the linked list
--| of dynamic strings implemented by this package.
--|DESIGN DESCRIPTION:
--| If ITEM > 0
--| Advance to desired item
--| End If
--| Return the DS field of the desired item
--=========================================================
ROVER : DYNAMIC_STRING := FIRST;
begin
if ITEM > 0 then
for I in 1 .. ITEM loop
ROVER := ROVER.NEXT;
end loop;
end if;
return ROVER.DS;
end GET_FROM_LIST;
end STRING_LIST;
procedure INITIALIZE (PROGRAM_NAME : in STRING;
COMMAND_LINE_PROMPT : in STRING) is
--========================= PDL ===========================
--|ABSTRACT:
--| INITIALIZE prompts the user for the command line
--| arguments and loads the linked list with them.
--|DESIGN DESCRIPTION:
--| Set CURRENT_STATE to LOOKING_FOR_TOKEN
--| Set PROGRAM_NAME as first token
--| Obtain the command line string from VAX/VMS
--| Over number of characters in line, loop
--| Case CURRENT_STATE
--| When LOOKING_FOR_TOKEN
--| If character is not white-space
--| Set CURRENT_STATE to IN_TOKEN
--| If character is quote (")
--| Set QUOTED to TRUE
--| Set START to the character's index + 1
--| Else
--| Set QUOTED to FALSE
--| Set START to the character's index
--| End IF
--| End If
--| When IN_TOKEN
--| If QUOTED
--| If character is quote (")
--| Set STOP to the previous character's index
--| Add slice from START to STOP to list
--| Set CURRENT_STATE to LOOKING_FOR_TOKEN
--| End If
--| ElsIF character is white-space
--| Set STOP to the previous character's index
--| Add slice from START to STOP to list
--| Set CURRENT_STATE to LOOKING_FOR_TOKEN
--| End If
--| End Case
--| End Loop
--| If CURRENT_STATE is IN_TOKEN
--| Set STOP to the previous character's index
--| Add slice from START to STOP to list
--| End if
--| Set LOCAL_ARGC to NUMBER_OF_STRINGS
--=========================================================
ARGCOUNT : NATURAL := 1;
INLINE : UTIL.COMMAND_STRING; -- for IntegrAda
INLEN : NATURAL; -- for IntegrAda
START : NATURAL;
STOP : NATURAL;
QUOTED : BOOLEAN;
type STATE is (LOOKING_FOR_TOKEN, IN_TOKEN);
CURRENT_STATE : STATE := LOOKING_FOR_TOKEN;
begin
STRING_LIST.ADD_TO_LIST (PROGRAM_NAME);
UTIL.COMMAND_LINE (INLINE, INLEN); -- INLINE is command line
for I in 1 .. INLEN loop
case CURRENT_STATE is
when LOOKING_FOR_TOKEN =>
if INLINE (I) > ' ' then
CURRENT_STATE := IN_TOKEN;
if INLINE (I) = '"' then
QUOTED := TRUE;
START := I;
else
QUOTED := FALSE;
START := I;
end if;
end if;
when IN_TOKEN =>
if QUOTED then
if INLINE (I) = '"' then
STOP := I;
STRING_LIST.ADD_TO_LIST (INLINE (START .. STOP));
CURRENT_STATE := LOOKING_FOR_TOKEN;
end if;
elsif INLINE (I) <= ' ' then
STOP := I - 1;
STRING_LIST.ADD_TO_LIST (INLINE (START .. STOP));
CURRENT_STATE := LOOKING_FOR_TOKEN;
end if;
end case;
end loop;
if CURRENT_STATE = IN_TOKEN then
STOP := INLEN;
STRING_LIST.ADD_TO_LIST (INLINE (START .. STOP));
end if;
LOCAL_ARGC := STRING_LIST.NUMBER_OF_STRINGS;
end INITIALIZE;
function ARGC return NATURAL is
--========================= PDL ===========================
--|ABSTRACT:
--| ARGC returns the argument count.
--|DESIGN DESCRIPTION:
--| Return LOCAL_ARGC
--=========================================================
begin
return LOCAL_ARGC;
end ARGC;
function ARGV (INDEX : in NATURAL) return STRING is
--========================= PDL ===========================
--|ABSTRACT:
--| ARGV returns the indicated argument string.
--|DESIGN DESCRIPTION:
--| If INDEX is out of range, raise INVALID_INDEX
--| Return GET_FROM_LIST(INDEX)
--=========================================================
begin
if INDEX >= LOCAL_ARGC then
raise INVALID_INDEX;
end if;
return STRING_LIST.GET_FROM_LIST (INDEX);
exception
when INVALID_INDEX =>
raise ;
when others =>
raise UNEXPECTED_ERROR;
end ARGV;
end CLI;
--::::::::::
--climerdn.ada
--::::::::::
-- ****************************************
-- * *
-- * CLI (Command Line Interface) * BODY
-- * for Meridian Ada, Version 3.x *
-- * requires AdaVantage Utility Library *
-- * *
-- ****************************************
with ARG; -- from AdaVantage Utility Library
package body CLI is
NAME_OF_PROGRAM : STRING(1..100);
NAME_OF_PROGRAM_LAST : NATURAL := 0;
-- ...................................
-- . .
-- . INITIALIZE . BODY
-- . .
-- ...................................
procedure INITIALIZE (PROGRAM_NAME : in STRING;
COMMAND_LINE_PROMPT : in STRING) is
begin
NAME_OF_PROGRAM(1..PROGRAM_NAME'LENGTH) := PROGRAM_NAME;
NAME_OF_PROGRAM_LAST := PROGRAM_NAME'LENGTH;
exception
when others => raise UNEXPECTED_ERROR;
end INITIALIZE;
-- ...................................
-- . .
-- . ARGC (Argument Count) . BODY
-- . .
-- ...................................
function ARGC return NATURAL is
begin
return ARG.COUNT;
exception
when others => raise UNEXPECTED_ERROR;
end ARGC;
-- ...................................
-- . .
-- . ARGV (Argument Value) . BODY
-- . .
-- ...................................
function ARGV (INDEX : in NATURAL) return STRING is
begin
if INDEX = 0 then
return NAME_OF_PROGRAM(1..NAME_OF_PROGRAM_LAST);
else
if INDEX >= ARGC then
raise INVALID_INDEX;
else
return ARG.DATA(POSITIVE(INDEX+1));
end if;
end if;
exception
when INVALID_INDEX => raise;
when others => raise UNEXPECTED_ERROR;
end ARGV;
end CLI;
--::::::::::
--cliverdx.ada
--::::::::::
-- This implementation of Package Body CLI is Verdix-specific (SUN).
-- The following Verdix Ada packages must be compiled into
-- the Ada library or an Ada program unit library containing these
-- packages must be placed in the library search path before this
-- package body is compiled:
-- standard/a_strings.a
-- standard/a_strings_b.a
-- standard/c_strings.a
-- standard/c_strings_b.a
-- verdixlib/cmd_line_s.a
-- verdixlib/cmd_line_b.a
-- Verdix Ada Development System, Version 5.41 and 5.5
with COMMAND_LINE;
with A_STRINGS;
package body CLI is
LOCAL_ARGC : NATURAL := NATURAL (COMMAND_LINE.ARGC);
-- Local value of ARGC stored internally
procedure INITIALIZE (PROGRAM_NAME : in STRING;
COMMAND_LINE_PROMPT : in STRING) is
--========================= PDL ===========================
--|ABSTRACT:
--| INITIALIZE prompts the user for the command line
--| arguments and loads the linked list with them.
--|DESIGN DESCRIPTION:
--| Do nothing (no initialization required)
--=========================================================
begin
null;
end INITIALIZE;
function ARGC return NATURAL is
--========================= PDL ===========================
--|ABSTRACT:
--| ARGC returns the argument count.
--|DESIGN DESCRIPTION:
--| Return LOCAL_ARGC
--=========================================================
begin
return LOCAL_ARGC;
end ARGC;
function ARGV (INDEX : in NATURAL) return STRING is
--========================= PDL ===========================
--|ABSTRACT:
--| ARGV returns the indicated argument string.
--|DESIGN DESCRIPTION:
--| If INDEX is out of range, raise INVALID_INDEX
--| Return COMMAND_LINE.ARGV.all (INTEGER (INDEX)).all.S
--=========================================================
begin
if INDEX >= LOCAL_ARGC then
raise INVALID_INDEX;
end if;
return COMMAND_LINE.ARGV.all (INTEGER (INDEX)).all.S;
exception
when INVALID_INDEX =>
raise ;
when others =>
raise UNEXPECTED_ERROR;
end ARGV;
end CLI;
--::::::::::
--clivms.ada
--::::::::::
-- This implementation of Package Body CLI is for DEC Ada using VAX/VMS.
-- It has been tested under VAX/VMS 4.5 using DEC Ada Version 1.3-24.
-- Note: any executable produced which uses this package must be able to
-- read the command line parameters. To do this, after producing the EXE
-- file via ACS LINK, you have to define a symbol like:
-- $ symbol:==$disk:[dir]exe-file-name
-- and then run the program by using the symbol:
-- $ symbol this is a test
package body CLI is
LOCAL_ARGC : NATURAL := 1;
-- Local ARGC value stored internally
package STRING_LIST is
NUMBER_OF_STRINGS : NATURAL := 0;
procedure ADD_TO_LIST (ITEM : in STRING);
function GET_FROM_LIST (ITEM : in NATURAL) return STRING;
end STRING_LIST;
package body STRING_LIST is
type DYNAMIC_STRING_OBJECT (LENGTH : NATURAL);
type DYNAMIC_STRING is access DYNAMIC_STRING_OBJECT;
type DYNAMIC_STRING_OBJECT (LENGTH : NATURAL) is
record
DS : STRING (1 .. LENGTH);
NEXT : DYNAMIC_STRING;
end record;
FIRST : DYNAMIC_STRING := null;
LAST : DYNAMIC_STRING := null;
procedure ADD_TO_LIST (ITEM : in STRING) is
--========================= PDL ===========================
--|ABSTRACT:
--| ADD_TO_LIST adds the ITEM string to the linked list
--| of dynamic strings implemented by this package.
--|DESIGN DESCRIPTION:
--| Create new DYNAMIC_STRING_OBJECT of the proper length
--| Set DS field of new object to the ITEM string
--| Set the NEXT field of the new object to NULL
--| If FIRST pointer is null
--| Set FIRST and LAST to point to the new object
--| Else
--| Set LAST.NEXT to point to the new object
--| Set LAST to point to the new object
--| End if
--| Increment NUMBER_OF_STRINGS
--=========================================================
TEMP : DYNAMIC_STRING;
begin
TEMP := new DYNAMIC_STRING_OBJECT (ITEM'LENGTH);
TEMP.DS (1 .. ITEM'LENGTH) := ITEM;
TEMP.NEXT := null;
if FIRST = null then
FIRST := TEMP;
LAST := TEMP;
else
LAST.NEXT := TEMP;
LAST := TEMP;
end if;
NUMBER_OF_STRINGS := NUMBER_OF_STRINGS + 1;
end ADD_TO_LIST;
function GET_FROM_LIST (ITEM : in NATURAL) return STRING is
--========================= PDL ===========================
--|ABSTRACT:
--| GET_FROM_LIST returns the ITEM string from the linked list
--| of dynamic strings implemented by this package.
--|DESIGN DESCRIPTION:
--| If ITEM > 0
--| Advance to desired item
--| End If
--| Return the DS field of the desired item
--=========================================================
ROVER : DYNAMIC_STRING := FIRST;
begin
if ITEM > 0 then
for I in 1 .. ITEM loop
ROVER := ROVER.NEXT;
end loop;
end if;
return ROVER.DS;
end GET_FROM_LIST;
end STRING_LIST;
procedure INITIALIZE (PROGRAM_NAME : in STRING;
COMMAND_LINE_PROMPT : in STRING) is
--========================= PDL ===========================
--|ABSTRACT:
--| INITIALIZE prompts the user for the command line
--| arguments and loads the linked list with them.
--|DESIGN DESCRIPTION:
--| Set CURRENT_STATE to LOOKING_FOR_TOKEN
--| Set PROGRAM_NAME as first token
--| Obtain the command line string from VAX/VMS
--| Over number of characters in line, loop
--| Case CURRENT_STATE
--| When LOOKING_FOR_TOKEN
--| If character is not white-space
--| Set CURRENT_STATE to IN_TOKEN
--| If character is quote (")
--| Set QUOTED to TRUE
--| Set START to the character's index + 1
--| Else
--| Set QUOTED to FALSE
--| Set START to the character's index
--| End IF
--| End If
--| When IN_TOKEN
--| If QUOTED
--| If character is quote (")
--| Set STOP to the previous character's index
--| Add slice from START to STOP to list
--| Set CURRENT_STATE to LOOKING_FOR_TOKEN
--| End If
--| ElsIF character is white-space
--| Set STOP to the previous character's index
--| Add slice from START to STOP to list
--| Set CURRENT_STATE to LOOKING_FOR_TOKEN
--| End If
--| End Case
--| End Loop
--| If CURRENT_STATE is IN_TOKEN
--| Set STOP to the previous character's index
--| Add slice from START to STOP to list
--| End if
--| Set LOCAL_ARGC to NUMBER_OF_STRINGS
--=========================================================
ARGCOUNT : NATURAL := 1;
INLINE : STRING (1 .. 132); -- for VAX/VMS
START : NATURAL;
STOP : NATURAL;
QUOTED : BOOLEAN;
type STATE is (LOOKING_FOR_TOKEN, IN_TOKEN);
CURRENT_STATE : STATE := LOOKING_FOR_TOKEN;
-- Get command line from VAX/VMS
procedure GET_FOREIGN (LINE : out STRING);
pragma INTERFACE (EXTERNAL, GET_FOREIGN);
pragma IMPORT_VALUED_PROCEDURE (GET_FOREIGN,
"LIB$GET_FOREIGN",
(STRING),
(DESCRIPTOR(S)));
begin
STRING_LIST.ADD_TO_LIST (PROGRAM_NAME);
GET_FOREIGN (INLINE); -- INLINE is command line from VAX/VMS
for I in INLINE'RANGE loop
case CURRENT_STATE is
when LOOKING_FOR_TOKEN =>
if INLINE (I) > ' ' then
CURRENT_STATE := IN_TOKEN;
if INLINE (I) = '"' then
QUOTED := TRUE;
START := I;
else
QUOTED := FALSE;
START := I;
end if;
end if;
when IN_TOKEN =>
if QUOTED then
if INLINE (I) = '"' then
STOP := I;
STRING_LIST.ADD_TO_LIST (INLINE (START .. STOP));
CURRENT_STATE := LOOKING_FOR_TOKEN;
end if;
elsif INLINE (I) <= ' ' then
STOP := I - 1;
STRING_LIST.ADD_TO_LIST (INLINE (START .. STOP));
CURRENT_STATE := LOOKING_FOR_TOKEN;
end if;
end case;
end loop;
if CURRENT_STATE = IN_TOKEN then
STOP := INLINE'LAST;
STRING_LIST.ADD_TO_LIST (INLINE (START .. STOP));
end if;
LOCAL_ARGC := STRING_LIST.NUMBER_OF_STRINGS;
end INITIALIZE;
function ARGC return NATURAL is
--========================= PDL ===========================
--|ABSTRACT:
--| ARGC returns the argument count.
--|DESIGN DESCRIPTION:
--| Return LOCAL_ARGC
--=========================================================
begin
return LOCAL_ARGC;
end ARGC;
function ARGV (INDEX : in NATURAL) return STRING is
--========================= PDL ===========================
--|ABSTRACT:
--| ARGV returns the indicated argument string.
--|DESIGN DESCRIPTION:
--| If INDEX is out of range, raise INVALID_INDEX
--| Return GET_FROM_LIST(INDEX)
--=========================================================
begin
if INDEX >= LOCAL_ARGC then
raise INVALID_INDEX;
end if;
return STRING_LIST.GET_FROM_LIST (INDEX);
exception
when INVALID_INDEX =>
raise ;
when others =>
raise UNEXPECTED_ERROR;
end ARGV;
end CLI;
